home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / tool_inc.zip / LOCKS.INC < prev    next >
Text File  |  1989-03-01  |  2KB  |  86 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * locks - set and clear locks
  15.  *
  16.  * used to manage shared resources
  17.  *
  18.  * s.h.smith, 9-mar-87
  19.  *
  20.  *)
  21.  
  22. function lock_set(lock: anystring): boolean;
  23.    {check to see if a lock is already set by another process}
  24. var
  25.    fd: file;
  26. begin
  27.    assign(fd,lock);
  28.    {$i-}
  29.    reset(fd);
  30.    {$i+}
  31.  
  32.    if ioresult <> 0 then
  33.       lock_set := false
  34.    else
  35.  
  36.    begin
  37.       close(fd);
  38.       lock_set := true;
  39.    end;
  40. end;
  41.  
  42.  
  43. procedure set_lock(lock: anystring);
  44.    {set a lock; wait if lock is already present}
  45. var
  46.    fd:   file;
  47.    try:  integer;
  48.  
  49. begin
  50.    try := 0;
  51.    while lock_set(lock) do
  52.    begin
  53.       try := try + 1;
  54.       if try = 5 then
  55.       begin
  56.          writeln(con,'Lock present: ',lock,' - program aborted');
  57.          writeln(con,'This resource could be allocated to another program.');
  58.          writeln(con,'Delete the file ',lock,' to remove the lock.');
  59.          halt(1);
  60.       end
  61.       else
  62.       begin
  63.          write(con,'<WAIT>'^H^H^H^H^H^H);
  64.          delay(500);
  65.          write(con,'      '^H^H^H^H^H^H);
  66.       end;
  67.    end;
  68.  
  69.    assign(fd,lock);
  70.    rewrite(fd);
  71.    close(fd);
  72. end;
  73.  
  74.  
  75. procedure clear_lock(lock: anystring);
  76. var
  77.    fd: file;
  78. begin
  79.    assign(fd,lock);
  80.    {$i-}
  81.    erase(fd);
  82.    {$i+}
  83.    if ioresult <> 0 then
  84.       writeln(con,'Lock missing: ',lock);
  85. end;
  86.